;; -*- coding:utf-8 mode: Emacs-lisp -*-
;; 8-muse.el --- Initialize muse-mode.
;; Time-stamp: <2008-05-30 22:23:03 qianxjun>

(add-to-list 'load-path "~/.emacs.d/site-lisp/muse")

(require 'muse-mode)     ; load authoring mode
(require 'muse-html)     ; load publishing styles I use
(require 'muse-latex)
(require 'muse-wiki)
(require 'muse-texinfo)
(require 'muse-docbook)
(require 'muse-project)  ; publish files in projects
(require 'muse-colors)

;;{{{  don't force inline-css
(require 'htmlize)
(defun htmlize-region-for-paste (beg end)
  "Htmlize the region and return just the HTML as a string.
This forces the `inline-css' style and only returns the HTML body,
but without the BODY tag.  This should make it useful for inserting
the text to another HTML buffer."
  (let ((htmlbuf (htmlize-region beg end)))
    (unwind-protect
        (with-current-buffer htmlbuf
          (buffer-substring (plist-get htmlize-buffer-places 'content-start)
                            (plist-get htmlize-buffer-places 'content-end)))
      (kill-buffer htmlbuf))))
;;}}}

(add-to-list 'magic-mode-alist
             '("#title " . muse-mode))
(defvar muse-tag-alist
  '(("example")
    ("literal")
    ("lisp" n)
    ("src" ("lang" ("emacs-lisp") ("perl") ("sql") ("c++") ("sh")) n))
  "Tag list for `sgml-tag'.")

(defun my-muse-mode-hook ()
  ;; auto insert
  (when (= (buffer-size) 0)
    (let ((page (muse-page-name)))
      (cond ((string= page "WikiIndex")
             (insert "#title 目录\n"
                     "<lisp>(ywb-muse-index-as-string t t t)</lisp>\n"))
            ((string= page "RecentChanges")
             (insert "#title 最近更新\n"
                     "<lisp>(ywb-muse-generate-recentchanges)</lisp>\n"))
            (t (insert "#title ")))))
  (auto-fill-mode 1)
  (define-key muse-mode-map (kbd "C-c C-c") 'ywb-muse-preview-source)
  (define-key muse-mode-map (kbd "C-c C-j") 'ywb-muse-preview-html)
  (define-key muse-mode-map (kbd "C-c C-m") 'ywb-muse-preview-with-w3m)
  ;; borrow some command from sgml mode
  (set (make-local-variable 'sgml-tag-alist) muse-tag-alist)
  (modify-syntax-entry ?> ")" muse-mode-syntax-table)
  (modify-syntax-entry ?< "(" muse-mode-syntax-table)
  (define-key muse-mode-map (kbd "C-c /") 'sgml-close-tag)
  (define-key muse-mode-map (kbd "C-c t") 'sgml-tag))

(add-hook 'muse-mode-hook 'my-muse-mode-hook)

(setq muse-wiki-ignore-bare-project-names t)

(defvar ywb-muse-recentchanges-page "RecentChanges"
  "Recent change page name. See `ywb-muse-generate-recentchanges'")

;;{{{  project setting
(setq muse-project-alist
      `(
        ("Default"                      
         ("~/Muse/default" :default "index" :force-publish ,(list ywb-muse-recentchanges-page))
         (:base "html" :path "~/Muse/publish_html/default"))
        ("Other"
         ("~/Muse/other" :default "index" :force-publish ,(list ywb-muse-recentchanges-page))
         (:base "html" :path "~/Muse/publish_html/other"))
        ("Report"
         ("~/Muse/report" :default "index")
         (:base "html" :path "~/issues/report"))
        ))
;;}}}

;;{{{  Recent change
(require 'file-stat nil t)
(when (not (fboundp 'file-stat-mtime))
  (defsubst file-stat-mtime (file &optional id-format)
    (nth 5 (file-attributes file id-format))))

(defvar ywb-muse-recentchanges-format "%Y年%m月%d日")

(defun ywb-muse-generate-recentchanges (&optional show-proj &rest project-list)
  "Generate recent changes of project files.

If SHOW-PROJ is non-nil, the index will add project name.
If PROJECT-LIST is given, all changes in these projects will display"
  (or project-list (setq project-list (list (car (muse-project)))))
  (let ((curr-file (muse-current-file))
        (curr-buf (current-buffer))
        (content "")
        last files header current changed beg pos)
    ;; if this file is not save yet, just return an empty string
    (if (not (file-exists-p curr-file))
        ""
      (with-temp-buffer
        (insert-file-contents curr-file)
        ;; search for last change time stamp.
        ;; if there is one, get it and update the time stamp
        ;; if didn't have one, insert current time stamp after directives
        (goto-char (point-min))
        (if (re-search-forward "^; last time stamp: \\([0-9]+\\(\\.[0-9]+\\)?\\)"
                               nil t)
            (progn
              (setq last (seconds-to-time (string-to-number (match-string 1))))
              ;; (re-search-forward "^; last time stamp: \\([0-9.]+\\)" nil t)
              (replace-match (number-to-string (float-time)) nil nil nil 1))
          (re-search-forward "^[^#]" nil t)
          (backward-char 1)
          (insert (format "; last time stamp: %d\n" (float-time))))
        ;; get all file in the project-list newer than last
        (setq files (ywb-muse-get-rc-page project-list (or last '(0 0))))
        (when files
          (re-search-forward "</lisp>")
          (forward-line 1)
          (setq beg (point))
          ;; insert href for the pages. Pages are collected under the
          ;; same header generated by `ywb-muse-recentchanges-format'
          (setq header (format-time-string
                        ywb-muse-recentchanges-format
                        (nth 2 (car files))))
          (insert "* " header "\n")
          (dolist (file files)
            (setq current (format-time-string
                           ywb-muse-recentchanges-format
                           (nth 2 file)))
            (unless (string= current header)
              (insert "\n* " current "\n")
              (setq header current))
            (insert " - [[" (car file) "#" (cadr file) "]["
                    (if show-proj (concat (car file) "-") "")
                    (cadr file) "]]"
                    ;; if the page is not register in the this
                    ;; recentchange, a new tag will add
                    (save-excursion
                      (if (re-search-forward
                           (regexp-quote (concat "[" (car file) "#" (cadr file) "]"))
                           nil t) "" " *(new)*"))
                    "\n"))
          (setq pos (point))
          (if (re-search-forward header nil t)
              ;; if we update this file in the same peroid, the duplicate
              ;; line should removed. 
              (progn
                (re-search-forward "^[*]" nil t)
                (setq content (mapconcat 'identity 
                                         (delete-dups (split-string (delete-and-extract-region beg (point)) "\n")) "\n"))
                (insert content)
                ;; make change in publishing buffer
                (save-excursion
                  (set-buffer curr-buf)
                  (save-restriction
                    (widen)
                    (goto-char (point-min))
                    (re-search-forward "^[*]" nil t)
                    (delete-region (point)
                                   (progn
                                     (re-search-forward "^[*]" nil t)
                                     (point))))))
            (setq content (buffer-substring beg (point))))
          (write-region (point-min) (point-max) curr-file)
          (message "Use M-x revert-buffer to update current buffer")))
      content)))

(defun ywb-muse-get-rc-page (project-list newer)
  (let (files mtime)
    (dolist (proj project-list)
      (dolist (file (muse-project-file-alist (muse-project proj)))
        (when (file-exists-p (cdr file))
          (setq mtime (file-stat-mtime (cdr file)))
          (if (and (time-less-p newer mtime)
                   ;; autosave file
                   (not (string-match "^\.#" (car file)))
                   ;; the page itself
                   (not (string= ywb-muse-recentchanges-page (car file))))
              (setq files (cons (list proj (car file) mtime) files))))))
    (sort files (lambda (f1 f2) (time-less-p (nth 2 f2) (nth 2 f1))))))
;;}}}

;;{{{  Generate Index with title
(defun ywb-muse-index-as-string (&optional as-list exclude-private exclude-current &rest project-list)
  "Generate the index of all wiki file using title.
See also `muse-index-as-string'.
PROJECT-LIST is the index of projects to insert.
"
  (unless project-list
    (setq project-list (list (car (muse-project)))))
  (let ((current (muse-page-name))
        (max-size 200)              ; the max size to search for title
        files title)
    (with-temp-buffer
      (dolist (project project-list)
        (setq files
              (sort (copy-alist (muse-project-file-alist project))
                    (function
                     (lambda (l r)
                       (string-lessp (car l) (car r))))))
        (when (and exclude-current current)
          (setq files (delete (assoc current files) files)))
        (unless (= (length project-list) 1)
          (insert "* " project "\n"))
        (dolist (file files)
          (when (and (file-exists-p (cdr file))
                     (not (and exclude-private
                               (muse-project-private-p (cdr file)))))
            (insert " - [[" project "#" (car file) "]["
                    (with-temp-buffer
                      (insert-file-contents (cdr file) nil 0 max-size)
                      (goto-char (point-min))
                      (if (re-search-forward "^#title\\s-*" nil t)
                          (buffer-substring (point) (line-end-position))
                        (car file)))
                    "]]\n"))))
      (insert "\n")
      (buffer-string))))
;;}}}

;;{{{  color src tag
(defun muse-colors-src-tag (beg end)
  "Strip properties and mark as literal."
  (let (face)
    (muse-unhighlight-region beg end)
    (save-excursion
      (goto-char beg)
      (let ((fs 1) content face-list fe mode
            (font-lock-verbose nil))
        (when (re-search-forward "<src\\s-*lang=\"\\(.*\\)\"\\s-*>" nil t)
          (setq mode (intern-soft (concat (match-string 1) "-mode"))
                beg (match-end 0))
          (when (and mode (fboundp mode))
            (goto-char end)
            (setq end
                  (if (re-search-backward "</src>" nil t)
                      (match-beginning 0)
                    (point-max))
                  content (buffer-substring-no-properties beg end))
            (with-temp-buffer
              (funcall mode)
              (insert content)
              (font-lock-fontify-buffer)
              (or (get-text-property fs 'face)
                  (setq fs (next-single-property-change fs 'face)))
              (while (and fs (< fs (point-max)))
                (setq fe (or (next-single-property-change fs 'face)
                             (point-max))
                      face (get-text-property fs 'face))
                (and face fe (setq face-list (cons (list (1- fs) (1- fe) face) face-list)))
                (setq fs fe)))
            (when face-list
              (dolist (f (nreverse face-list))
                (put-text-property (+ beg (car f)) (+ beg (cadr f))
                                   'face (nth 2 f))))))))))
(add-to-list 'muse-colors-tags '("src" t nil nil muse-colors-src-tag))
;;}}}

;;{{{  math tag
(defun ywb-muse-publish-math-tag (beg end attrs)
  (require 'org)
  (let ((tag (or (cdr (assoc "tag" attrs)) "span")))
    (insert (concat "<" tag " class=\"math\">"
                    (org-export-html-convert-sub-super
                     (delete-and-extract-region beg end))
                    "</" tag ">"))
    (muse-publish-mark-read-only beg (point))))
(add-to-list 'muse-html-markup-tags
             '("math" t t t ywb-muse-publish-math-tag))
;;}}}

;;{{{  Preview commands
(defun ywb-muse-output-file ()
  (let ((style (muse-style
                (muse-project-get-applicable-style buffer-file-name
                                                   (cddr muse-current-project)))))
    (muse-publish-output-file buffer-file-name
                              (muse-style-element :path style) style)))
(defun ywb-muse-preview-with-w3m ()
  "Preview the html file"
  (interactive)
  (muse-project-publish-this-file)
  (let ((file (ywb-muse-output-file)))
    (w3m-goto-url (if (string-match "^[a-zA-Z]:" file)
                      (ywb-convert-to-cygwin-path file)
                    (concat "file://" file)))))

(defun ywb-muse-preview-html ()
  "Preview the html file"
  (interactive)
  (muse-project-publish-this-file)
  (browse-url (ywb-muse-output-file)))

(defun ywb-muse-preview-source ()
  "Find the html file"
  (interactive)
  (muse-project-publish-this-file)
  (find-file (ywb-muse-output-file)))
;;}}}

(defun ywb-muse-create-wikisource ()
  "Create all wikisource directory using file symbol link"
  (interactive)
  (dolist (proj muse-project-alist)
    (let ((source (expand-file-name (car (cadr proj))))
          (wikisource
           (expand-file-name (concat (muse-get-keyword :path (nth 2 proj)) "/" "wikisource"))))
      (when (and (file-exists-p source)
                 (not (file-exists-p wikisource)))
        (message "Create link %s" wikisource)
        (call-process "ln" nil nil nil "-s" source wikisource)))))

(defun wcy-wiki-chinese-fixe-word ()
  (save-excursion
    (replace-regexp "\\(\\cC\\)\n[ \t]+\\(\\cC\\)" "\\1\\2" nil 0 (1+ (buffer-size)))))

;; 增加 --all 参数发布所有项目，除去重复的 project 名
(defun muse-project-batch-publish ()
  "Publish Muse files in batch mode."
  (let ((muse-batch-publishing-p t)
        force)
    (if (string= "--force" (or (car command-line-args-left) ""))
        (setq force t
              command-line-args-left (cdr command-line-args-left)))
    (if (string= "--all" (or (car command-line-args-left) ""))
        (setq command-line-args-left (nconc (cdr command-line-args-left)
                                            (mapcar 'car muse-project-alist))))
    (if command-line-args-left
        (dolist (project (delete-dups command-line-args-left))
          (message "Publishing project %s ..." project)
          (muse-project-publish project force))
      (message "No projects specified."))))

;;; header and footer setting
(setq muse-html-meta-content-encoding "utf-8")
(setq muse-html-style-sheet "<link rel=\"stylesheet\" type=\"text/css\" href=\"core.css\">")

(setq muse-html-header "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">
<html>
  <head>
    <meta name=\"generator\" content=\"muse.el\">
    <meta http-equiv=\"<lisp>muse-html-meta-http-equiv</lisp>\"
          content=\"<lisp>muse-html-meta-content-type</lisp>\">
    <lisp>
      (let ((maintainer (muse-style-element :maintainer)))
        (when maintainer
          (concat \"<link rev=\\\"made\\\" href=\\\"\" maintainer \"\\\">\")))
    </lisp>
    <lisp>(let ((style (muse-publishing-directive \"style\")))
             (if style
                 (concat \"<link rel=\\\"stylesheet\\\" type=\\\"text/css\\\" href=\\\"\"
                         style \"\\\">\")
               muse-html-style-sheet))
     </lisp>
  <title><lisp>
  (concat (muse-publishing-directive \"title\")
          (let ((author (muse-publishing-directive \"author\")))
            (if (not (string= author (user-full-name)))
                (concat \" (by \" author \")\"))))</lisp></title>

  </head>
  <body>
    <h1><lisp>
  (concat (muse-publishing-directive \"title\")
          (let ((author (muse-publishing-directive \"author\")))
            (if (not (string= author (user-full-name)))
                (concat \" (by \" author \")\"))))</lisp></h1>
    <!-- Page published by Emacs Muse begins here -->\n")

(setq muse-html-footer "
<!-- Page published by Emacs Muse ends here -->
    <div class=\"navfoot\">
      <hr />
      <table width=\"100%\" border=\"0\" summary=\"Footer navigation\">
        <col width=\"33%\" /><col width=\"34%\" /><col width=\"33%\" />
        <tr>
          <td align=\"left\">
            <lisp>
                  (concat
                   \"<span class=\\\"footdate\\\">Updated: \"
                   (format-time-string \"%Y-%m-%d\"
                    (nth 5 (file-attributes muse-publishing-current-file)))
                   \"</span>\")
            </lisp>
          </td>
          <td align=\"center\">
            <span class=\"foothome\">
              <a href=\"../WelcomePage.html\">Home</a> / <a href=\"../WikiIndex.html\">Index</a>
            </span>
          </td>
          <td align=\"right\">
            <span class=\"footmark\">
                 Maintained by Julian
            </span>
          </td>
  </body>
</html>")

(setq muse-latexcjk-encoding-default "{UTF8}{song}")
(setq muse-latex-header "\\documentclass{article}
\\usepackage{CJKutf8}
\\usepackage{indentfirst}
\\usepackage[english]{babel}
\\usepackage[latin1]{inputenc}
\\usepackage[T1]{fontenc}
\\usepackage[CJKbookmarks=true]{hyperref}
\\usepackage[pdftex]{graphicx}

\\newcommand{\\comment}[1]{}
\\begin{document}
\\begin{CJK*}{UTF8}{song}

\\title{<lisp>(muse-publishing-directive \"title\")</lisp>}
\\author{<lisp>(muse-publishing-directive \"author\")</lisp>}
\\date{<lisp>(muse-publishing-directive \"date\")</lisp>}

\\maketitle

<lisp>(and muse-publish-generate-contents
           \"\\\\tableofcontents
\\\\newpage\")</lisp>

")

(setq muse-latex-footer "
\\end{CJK*}
\\end{document}
")

(setq muse-latex-slides-header "\\documentclass{beamer}
\\usepackage{beamerthemesplit}
\\usepackage{CJK}

\\begin{document}
\\begin{CJK*}{GBK}{song}

\\title{<lisp>(muse-publishing-directive \"title\")</lisp>}
\\author{<lisp>(muse-publishing-directive \"author\")</lisp>}
\\date{<lisp>(muse-publishing-directive \"date\")</lisp>}

\\frame{\\titlepage}

\\section[Outline]{}
\\frame{\\tableofcontents}

")